home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 168 / 168.d81 / lunar eclipses (.txt) < prev    next >
Commodore BASIC  |  2022-08-26  |  3KB  |  144 lines
  1. 5 poke55,.:poke56,56:clr
  2. 6 dv=peek(186):ifdv<8thendv=8
  3. 7 poke53280,.:poke53281,.:print"[147]"
  4. 8 poke53371,.
  5. 9 poke53272,31
  6. 10 ad=49152
  7. 15 sysad:sysad+12
  8. 25 print"[147]":sysad+9,0
  9. 30 printtab(6)"[154][204][213][206][193][210] [197][195][204][201][208][211][197] [208][210][197][196][201][195][212][207][210]"
  10. 35 r1=(NULL)/180:u=0
  11. 40 printtab(11)"[153][217]ear: ";:l9%=4:gosub510:y=q9
  12. 45 g=1:ify<1583theng=0
  13. 50 print
  14. 55 k0=int((y-1900)*12.3685)
  15. 60 t=(y-1899.5)/100
  16. 65 t2=t*t:t3=t*t*t
  17. 70 j0=2415020+29*k0
  18. 75 f0=.0001178*t2-.000000155*t3
  19. 80 f0=f0+.75933+.53058868*k0
  20. 85 f0=f0-.000837*t-.000335*t2
  21. 90 j0=j0+int(f0):f0=f0-int(f0)
  22. 95 m0=k0*.08084821133
  23. 100 m0=360*(m0-int(m0))+359.2242
  24. 105 m0=m0-.0000333*t2
  25. 110 m0=m0-.00000347*t3
  26. 115 m1=k0*.07171366128
  27. 120 m1=360*(m1-int(m1))+306.0253
  28. 125 m1=m1+.0107306*t2
  29. 130 m1=m1+.00001236*t3
  30. 135 b1=k0*.08519585128
  31. 140 b1=360*(b1-int(b1))+21.2964
  32. 145 b1=b1-.0016528*t2
  33. 150 b1=b1-.00000239*t3
  34. 155 fork9=1to27step 2
  35. 160 j=j0+14*k9:f=f0+.765294*k9
  36. 165 k=k9/2
  37. 170 m5=(m0+k*29.10535608)*r1
  38. 175 m6=(m1+k*385.81691806)*r1
  39. 180 b6=(b1+k*390.67050646)*r1
  40. 185 f=f-.4068*sin(m6)
  41. 190 f=f+(.1734-.000393*t)*sin(m5)
  42. 195 f=f+.0161*sin(2*m6)
  43. 200 f=f-.0104*sin(2*b6)
  44. 205 f=f-.0074*sin(m5-m6)
  45. 210 f=f-.0051*sin(m5+m6)
  46. 215 f=f+.0021*sin(2*m5)
  47. 220 f=f+.5/1440
  48. 225 j=j+int(f):f=f-int(f)
  49. 230 gosub260
  50. 235 next
  51. 240 gosub30000
  52. 250 poke198,.:goto25
  53. 260 rem lunar eclipse subroutine
  54. 265 d7=0
  55. 270 ifabs(sin(b6))>.36then505
  56. 275 s=5.19595-.0048*cos(m5)
  57. 280 s=s+.0020*cos(2*m5)
  58. 285 s=s-.3283*cos(m6)
  59. 290 s=s-.0060*cos(m5+m6)
  60. 295 s=s+.0041*cos(m5-m6)
  61. 300 c1=.2070*sin(m5)
  62. 305 c1=c1+.0024*sin(2*m5)
  63. 310 c1=c1-.0390*sin(m6)
  64. 315 c1=c1+.0115*sin(2*m6)
  65. 320 c1=c1-.0073*sin(m5+m6)
  66. 325 c1=c1-.0067*sin(m5-m6)
  67. 330 c1=c1+.0117*sin(2*b6)
  68. 335 d9=abs(s*sin(b6)+c1*cos(b6))
  69. 340 u=.0059+.0046*cos(m5)
  70. 345 u=u-.0182*cos(m6)
  71. 350 u=u+.0004*cos(2*m6)
  72. 355 u=u-.0005*cos(m5+m6)
  73. 360 rp=1.2847+u:ru=.7404-u
  74. 365 mp=(1.5572+u-d9)/.545
  75. 370 ifmp<0then505
  76. 375 mu=(1.0129-u-d9)/.545
  77. 380 d5=1.5572+u:d6=1.0129-u
  78. 385 d7=.4679-u
  79. 390 n=(.5458+.04*cos(m6))/60
  80. 395 d5=sqr(d5*d5-d9*d9)/n
  81. 400 ifmu<=0then420
  82. 405 d6=sqr(d6*d6-d9*d9)/n
  83. 410 ifmu<=1then420
  84. 415 d7=sqr(d7*d7-d9*d9)/n
  85. 420 gosub555
  86. 422 sysad+9,1
  87. 425 print"[158][196]ate: [146]";y;m;d1
  88. 430 print"[153][205]ax-phase: ";
  89. 435 printh1;":";m9;"[153][213][212]"
  90. 440 mp=int(1000*mp+.5)/1000
  91. 445 print"[159][208]enumbral mag: ";mp
  92. 450 ifmu<=0thenprint:goto465
  93. 455 mu=int(1000*mu+.5)/1000
  94. 460 print"[159][213]mbral mag: ";mu
  95. 465 printtab(23)"[158][145][145][145][145]-[211]emidurations-[146]"
  96. 470 d5=int(d5+.5):rem round off
  97. 475 printtab(22)"[155][208]enumbra:";d5;"[155]min"
  98. 480 ifmu<0then500
  99. 485 d6=int(d6+.5):d7=int(d7+.5)
  100. 490 printtab(22)"[152][213]mbra:";d6;"[152]min"
  101. 495 printtab(22)"[150][212][207][212][193][204][201][212][217]:";d7;"[150]min":goto505
  102. 500 print:print
  103. 505 return
  104. 510 q9$="":poke198,.
  105. 512 geta$
  106. 514 poke646,rnd(1)*15+1:print"*[157]";:ifa$=""then512
  107. 516 ifa$=chr$(13)thenprint" ":q9=val(q9$):return
  108. 518 if(a$=chr$(20)andlen(q9$))thenq9$=left$(q9$,len(q9$)-1):goto530
  109. 520 iflen(q9$)>=l9%thensysad+9,2:goto512
  110. 522 if(a$>="0"anda$<="9")ora$="."ora$="-"then526
  111. 524 goto512
  112. 526 q9$=q9$+a$
  113. 528 print""a$;:sysad+9,6:goto512
  114. 530 print" [157][157] [157]";:goto512
  115. 555 rem julian calendar
  116. 560 f=f+.5
  117. 565 iff<1then575
  118. 570 f=f-1:j=j+1
  119. 575 ifg=1then585
  120. 580 a=j:goto595
  121. 585 a1=int((j/36524.25)-51.12264)
  122. 590 a=j+1+a1-int(a1/4)
  123. 595 b=a+1524
  124. 600 c=int((b/365.25)-.3343)
  125. 605 d=int(365.25*c)
  126. 610 e=int((b-d)/30.61)
  127. 615 d=b-d-int(30.61*e)+f
  128. 620 m=e-1:y=c-4716
  129. 625 ife>13.5thenm=m-12
  130. 630 ifm<2.5theny=y+1
  131. 635 d1=int(d):h=24*(d-d1)
  132. 640 h1=int(h):m9=int(60*(h-h1))
  133. 645 return
  134. 10000 d=peek(186):n$="lunar eclipses":open15,d,15,"s0:"+n$:close15:saven$,d:end
  135. 30000 poke214,21:print:printtab(8)"[159](1[159]) [212]ry another one
  136. 30010 [153][163]8)"open(2open) (NULL)o (NULL)(NULL)right$(NULL)val(NULL)(NULL)val (NULL)enu"
  137. 30020 [158]ad[170]9,15:[151]198,0
  138. 30030 [161]a$:[139]a$[179]"1"[176]a$[177]"2"[167]30030
  139. 30040 [139]a$[178]"1"[167][142]
  140. 30050 [158]ad[170]15
  141. 30060 [153]"loadstopload"[199](34)"b.universe ii"[199](34)","dv
  142. 30070 [153]"run28"
  143. 30080 [151]631,13:[151]632,13:[151]198,2:[128]
  144.